home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1997 May / PC Plus Super CD Issue 127 (May 1997).iso / delphi1 / lesson4 / todolist / calend1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-01-12  |  3.7 KB  |  139 lines
  1. unit Calend1;
  2. { a popup calendar }
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Grids, Calendar, StdCtrls, ExtCtrls;
  8.  
  9. type
  10.   TCalForm = class(TForm)
  11.     Calendar1: TCalendar;
  12.     LastMonthBtn: TButton;
  13.     NextMonthBtn: TButton;
  14.     OKBtn: TButton;
  15.     LastYearBtn: TButton;
  16.     NextYearBtn: TButton;
  17.     TodayBtn: TButton;
  18.     Panel1: TPanel;
  19.     DateLabel: TLabel;
  20.     procedure Calendar1Change(Sender: TObject);
  21.     procedure LastMonthBtnClick(Sender: TObject);
  22.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  23.     procedure FormCreate(Sender: TObject);
  24.     procedure NextMonthBtnClick(Sender: TObject);
  25.     procedure OKBtnClick(Sender: TObject);
  26.     procedure LastYearBtnClick(Sender: TObject);
  27.     procedure NextYearBtnClick(Sender: TObject);
  28.     procedure TodayBtnClick(Sender: TObject);
  29.   private
  30.     { Private declarations }
  31.   public
  32.     { Public declarations }
  33.   end;
  34.  
  35. var
  36.   CalForm: TCalForm;
  37.  
  38. implementation
  39. uses ToDo1;
  40. {$R *.DFM}
  41.  
  42. procedure TCalForm.Calendar1Change(Sender: TObject);
  43. var
  44.   date_string, label_string,
  45.   day_string, month_string, year_string : string;
  46. begin
  47.  day_string := IntToStr(Calendar1.Day);
  48.  month_string := IntToStr(Calendar1.Month);
  49.  year_string := IntToStr(Calendar1.Year);
  50. { ShortDateFormat is a global constant indicating
  51.   the international date format used by Windows.
  52.    Possible values are: m/d/y, d/m/y, and y/m/d.
  53.    This routine formats the date according to this
  54.    constant. }
  55.  case( upcase(ShortDateFormat[1]) ) of
  56.   'Y': date_string :=  year_string + '/' +
  57.                        month_string + '/' +
  58.                        day_string;
  59.   'M': date_string :=  month_string + '/' +
  60.                        day_string + '/' +
  61.                        year_string;
  62.   else date_string :=  day_string + '/' +
  63.                        month_string + '/' +
  64.                        year_string;
  65.  end; { case }
  66.  Caption := FormatDateTime(ShortDateFormat, StrToDate(date_String));
  67.  
  68.  { show selected Month and year in label }
  69.  case (Calendar1.Month) of
  70.    1: label_string := 'January';
  71.    2: label_string := 'February';
  72.    3: label_string := 'March';
  73.    4: label_string := 'April';
  74.    5: label_string := 'May';
  75.    6: label_string := 'June';
  76.    7: label_string := 'July';
  77.    8: label_string := 'August';
  78.    9: label_string := 'September';
  79.    10: label_string := 'October';
  80.    11: label_string := 'November';
  81.    12: label_string := 'December';
  82.  end;
  83.    DateLabel.Caption  := label_string + ' ' + year_string;
  84. end;
  85.  
  86. procedure TCalForm.LastMonthBtnClick(Sender: TObject);
  87. begin
  88.  Calendar1.PrevMonth;
  89. end;
  90.  
  91. procedure TCalForm.FormClose(Sender: TObject; var Action: TCloseAction);
  92. begin
  93.   CalForm.Hide;
  94.   ToDoForm.DateDueEditBox.Text := Caption;
  95. end;
  96.  
  97. procedure TCalForm.FormCreate(Sender: TObject);
  98. begin
  99.   { resize calendar around the panel object }
  100.   ClientHeight := Panel1.Height;
  101.   ClientWidth := Panel1.Width;
  102.   Calendar1Change(Sender);
  103. end;
  104.  
  105. procedure TCalForm.NextMonthBtnClick(Sender: TObject);
  106. begin
  107.  Calendar1.NextMonth;
  108. end;
  109.  
  110. procedure TCalForm.OKBtnClick(Sender: TObject);
  111. begin
  112.   Close;
  113. end;
  114.  
  115. procedure TCalForm.LastYearBtnClick(Sender: TObject);
  116. begin
  117.   Calendar1.PrevYear;
  118. end;
  119.  
  120. procedure TCalForm.NextYearBtnClick(Sender: TObject);
  121. begin
  122.   Calendar1.NextYear;
  123. end;
  124.  
  125. procedure TCalForm.TodayBtnClick(Sender: TObject);
  126. var
  127.   Present: TDateTime;
  128.   Year, Month, Day, Hour, Min, Sec, MSec: Word;
  129.  begin
  130.   Present:= Now;
  131.   DecodeDate(Present, Year, Month, Day);
  132.   Calendar1.Day := 1; { make sure the selected day is valid }
  133.   Calendar1.Year := Year; { even if month is a short one!   }
  134.   Calendar1.Month := Month;
  135.   Calendar1.Day := Day;
  136. end;
  137.  
  138. end.
  139.